home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1995 #5 & #6
/
Amiga Plus CD - 1995 - No. 5 and 6.iso
/
pd
/
daten
/
twistdemo
/
aminet
/
extractaminetarchive
< prev
next >
Wrap
Text File
|
1995-03-21
|
3KB
|
180 lines
/**
* $Id$
*
* Extract Aminet archives
*
* Copyright © 1995 HiSoft. All Rights Reserved.
**/
ADDLIB('rexxsupport.library',0,-30,0)
OPTIONS RESULTS
ADDRESS Twist
PARSE ARG dbfilename,rela_x,rela_y,shiftkeys
OPEN dbfilename
DBLENGTH = LENGTH(dbfilename)
do n = 1 to DBLENGTH by 1
X = right(dbfilename,n)
Y = Substr(X,1,1)
IF Y = "/" then do
VIEWERLOCATION = left(dbfilename,DBLENGTH-n) || '/Viewer.DB'
n = DBLENGTH
END
end
GETDBFORMMODE
GETDBFORMFIELD "Archivefield"
ARCHIVE = result
GETDBFORMFIELD "FileName"
ARCHIVENAME = result
ARCLENGTH = LENGTH(ARCHIVE)
FILETYPE = SUBSTR(ARCHIVE, (ARCLENGTH-2), 3)
FILETYPE = UPPER(FILETYPE)
IF exists('ENV:all') = 1 then do
DELETE('ENV:all')
END
CALL CLEANENV
IF FILETYPE = "ARC" | FILETYPE = "LZH" | FILETYPE = "LHA" then do
ADDRESS COMMAND 'setenv all `echo a`'
ADDRESS COMMAND 'setenv drawer `RequestFile RAM: TITLE="Select a drawer to extract the ' || ARCHIVENAME || ' to." DRAWERSONLY`'
CALL TESTFORFILES
ADDRESS COMMAND 'lha x "' || ARCHIVE || '" `type ENV:drawer` >CON: <env:all'
DELETE('ENV:drawer')
DELETE('ENV:all')
EXIT
End
IF FILETYPE = "LZX" then do
ADDRESS COMMAND 'setenv all `echo a`'
ADDRESS COMMAND 'setenv drawer `RequestFile RAM: TITLE="Select a drawer to extract the ' || ARCHIVENAME || ' to." DRAWERSONLY`'
ADDRESS COMMAND 'LZX x "' || ARCHIVE || '" `type ENV:drawer` >CON: <env:all'
DELETE('ENV:drawer')
DELETE('ENV:all')
EXIT
End
IF FILETYPE = "DMS" then do
GETDBFORMFIELD "DMS_WriteTo"
DMS_WRITETO = result
GETDBFORMFIELD "DMS_STARTSTOP"
DMS_STARTSTOP = result
IF DMS_STARTSTOP = "0-79" | DMS_STARTSTOP = "" then do
DMS_START = "0"
DMS_END = "79"
END
IF DMS_STARTSTOP = "0-40" then do
DMS_START = "0"
DMS_END = "40"
END
IF DMS_STARTSTOP = "40-79" then do
DMS_START = "40"
DMS_END = "79"
END
IF exists(ARCHIVE) = 0 then do
SAY "File is not on this CD"
EXIT
END
ADDRESS COMMAND 'DMS write "' || ARCHIVE || '" TO "' || DMS_WRITETO || '" LOW "' || DMS_START || '" HIGH "' || DMS_END || '" >CON:'
EXIT
END
IF FILETYPE = "RUN" then do
ADDRESS COMMAND 'setenv drawer `RequestFile RAM: TITLE="Select a drawer to extract the ' || ARCHIVENAME || ' to." DRAWERSONLY`'
IF exists('ENV:drawer') = 0 then do
EXIT
END
IF exists(ARCHIVE) = 0 then do
SAY "File is not on this CD"
EXIT
END
ADDRESS COMMAND '"' || ARCHIVE || '" `type ENV:drawer` >CON:'
DELETE('ENV:drawer')
EXIT
END
IF FILETYPE ~= "ARC" | FILETYPE ~= "LZH" | FILETYPE ~= "LHA" ~= "RUN" | FILETYPE ~= "DMS" then do
GETDBFORMFIELD "Viewer.Viewer"
FILE_VIEWER = result
IF FILE_VIEWER = "" then do
FILE_VIEWER = "MultiView"
IF exists('ENV:AminetViewer') = 1 then do
Open(input, 'ENV:AminetViewer', R)
FILE_VIEWER = Readln(input)
END
SETDBFORMFIELD Viewer.Viewer FILE_VIEWER
END
IF exists(VIEWERLOCATION) = 0 then do
SAY "Viewer database cannot be found"
EXIT
END
OPEN VIEWERLOCATION
'SELECTALL WHERE "Viewer == \"' || FILE_VIEWER ||'\""',
'STEM VIEWER'
FILEVIEWER = VIEWER.ViewerPath
ADDRESS COMMAND 'setenv AminetViewer "'|| FILE_VIEWER ||'"'
ADDRESS COMMAND 'COPY ENV:AminetViewer ENVARC:'
ADDRESS COMMAND ' "' || FILEVIEWER || '" <NIL: >NIL: "' || ARCHIVE || '" '
EXIT
END
TESTFORFILES:
IF exists('ENV:drawer') = 0 then do
EXIT
END
IF exists(ARCHIVE) = 0 then do
SAY "File is not on this CD"
CALL EXITSCRIPT
END
RETURN
CLEANENV:
IF exists('ENV:drawer') = 1 then do
DELETE('ENV:drawer')
END
IF exists('ENV:all') = 1 then do
DELETE('ENV:all')
END
RETURN
EXITSCRIPT:
EXIT
RETURN